Shareware Grab Bag/Shareware Grab Bag.iso/090/byt0187b.arc/LINKLIST.PAS

Pascal/Delphi Source File | 1986-10-28 | 8KB | 340 lines

(**********************************************************************)
(*                LINKLIST.PAS                  *)
(*                                      *)
(* This program maintains an ordered linked list of strings.  It is   *)
(* designed for an Apple IIe or an Apple II+ with an 80-column card.  *)
(* If you're using Pascal with 40 columns, all that has to be changed *)
(* is the number 40 in the GOTOXY calls.  A printer is also assumed.  *)
(* If you have none online, then one procedure call must be removed,  *)
(* and it is marked as such in the program.                  *)
(*                                      *)
(* The program commands are as follows:                   *)
(*    A)dd - adds string to list                      *)
(*    D)elete - deletes string from list                  *)
(*    B)lank - destroys list                          *)
(*    P)rint - dumps list to printer                      *)
(*    E)nd - terminates program                      *)
(* Please note that on an Apple IIe the Caps Lock button must be      *)
(* depressed for the program to accept these commands.              *)
(**********************************************************************)

PROGRAM MANAGER;

{ WARNING: shuts off range checking }
(*$R-*)

TYPE
    COMCHARS=SET OF CHAR;

    ST1=STRING[15];
    ST2=STRING[6];

    LISTPOINT=^NODE;
    NODE=RECORD
        NAME:ST1;
        LINK:LISTPOINT;
         END;

VAR
    LIST      : LISTPOINT;    { linked list head }
    TARGET      : ST1;    { string to be manipulated }
    COMMAND   : CHAR;    { input operation to list }
    PROPCOMS  : COMCHARS;    { set of proper commands }
    HEAP      : ^INTEGER;    { holds heap marker }

(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
(*                                   *)
(*            PROCEDURES AND FUNCTIONS               *)
(*                                   *)
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

    (************************************************)
    (*                        *)
    (*             Previous            *)
    (*                        *)
    (************************************************)

{ this procedure returns a pointer to the node before the target node or nil }

FUNCTION PREVIOUS(LIST:LISTPOINT; TARGET:ST1):LISTPOINT;

VAR
    CURRENT:LISTPOINT; { current position pointer }

BEGIN
    { CURRENT is initialized to beginning of list }
    CURRENT:=LIST;

    { move node pointer until target or end of list is encountered }
    WHILE (CURRENT^.LINK^.NAME<TARGET) AND (CURRENT^.LINK<>NIL)
    DO BEGIN
         CURRENT:=CURRENT^.LINK
       END;

    PREVIOUS:=CURRENT
END;

    (************************************************)
    (*                        *)
    (*              Add            *)
    (*                        *)
    (************************************************)

    { adds a node to the list in between two nodes }

PROCEDURE ADD(VAR PREV:LISTPOINT);

VAR
    TEMP:LISTPOINT;

BEGIN
    TEMP:=PREV^.LINK;
    NEW(PREV^.LINK);
    PREV^.LINK^.NAME:=TARGET;
    PREV^.LINK^.LINK:=TEMP
END;

    (************************************************)
    (*                        *)
    (*            Insert            *)
    (*                        *)
    (************************************************)

        { insert new node in list }

PROCEDURE INSERT(LIST:LISTPOINT;TARGET:ST1);

VAR
    PREV:LISTPOINT;

BEGIN
    PREV:=PREVIOUS(LIST,TARGET);

    { check to see if element is already in list }
    IF PREV^.LINK^.NAME=TARGET
      THEN
        BEGIN
        GOTOXY(40,10);
        WRITELN('Element in list alread');
        WRITE(CHR(7));WRITE(CHR(7))
        END
      ELSE
        ADD(PREV)
END;

    (************************************************)
    (*                        *)
    (*           Subtract            *)
    (*                        *)
    (************************************************)

         { remove a node in between two others }

PROCEDURE SUBTRACT(VAR PREV:LISTPOINT);

BEGIN
    PREV^.LINK:=PREV^.LINK^.LINK
END;

    (************************************************)
    (*                        *)
    (*            Delete            *)
    (*                        *)
    (************************************************)

        { delete a node from list }

PROCEDURE DELETE(LIST:LISTPOINT;TARGET:ST1);

VAR
    PREV:LISTPOINT;

BEGIN
    PREV:=PREVIOUS(LIST,TARGET);

    { check to see if target is in list }
    IF (PREV^.LINK=NIL) OR (PREV^.LINK^.NAME<>TARGET)
      THEN
        BEGIN{ then }
        GOTOXY(40,10);
        WRITELN('Target not found !!!');
        WRITE(CHR(7));WRITE(CHR(7))
        END{ then }
      ELSE
        SUBTRACT(PREV)
END;

    (************************************************)
    (*                        *)
    (*            Show Mem            *)
    (*                        *)
    (************************************************)

             { show memory left }

PROCEDURE SHOW_MEM;

BEGIN
  { uses the built-in function MEMAVAIL to return number of works left }

    GOTOXY(40,20);

    { check to see if there is a reasonable amount of memory left }
    IF MEMAVAIL>100
      THEN
        WRITE('There are ',MEMAVAIL:5,' words of memory left')
      ELSE
        BEGIN
        WRITELN(':NEARING END OF MEMORY !!');
        WRITE(CHR(7));WRITE(CHR(7))
        END
END;

    (************************************************)
    (*                        *)
    (*          Print List            *)
    (*                        *)
    (************************************************)

      { send contents of list to device specified }

PROCEDURE PRINT_LIST(LIST:LISTPOINT;DEVICE:ST1);

VAR
    CURRENT:LISTPOINT;
    OUT:TEXT; { variable representing output file }
BEGIN

    { set up device communication }
    REWRITE(OUT,DEVICE);
    PAGE(OUT);

    CURRENT:=LIST;

    { send information to device }
    WRITELN(OUT,'Current elements in the list are:');
    WRITELN(OUT,'------- -------- -- --- ---- ---');

    WHILE CURRENT^.LINK<>NIL
    DO BEGIN
         WRITELN(OUT,CURRENT^.LINK^.NAME);
         CURRENT:=CURRENT^.LINK
       END;

    SHOW_MEM
END; { print_list }

    (************************************************)
    (*                        *)
    (*            Get Name            *)
    (*                        *)
    (************************************************)

        { get string to be manipulated }

PROCEDURE GET_NAME(VAR TARGET:ST1;PROC:ST2);

BEGIN
    GOTOXY(40,2);
    WRITELN('Which string do you wish to ',PROC);
    GOTOXY(40,3);
    WRITE('-----> ');
    READ(TARGET)
END;

    (************************************************)
    (*                        *)
    (*            Kill List            *)
    (*                        *)
    (************************************************)

          { destroy contents of list }

PROCEDURE KILL_LIST(LIST:LISTPOINT);

BEGIN
    RELEASE(HEAP);

    { tie up only link remaining after heap is destroyed }
    LIST^.LINK:=NIL;

    PAGE(OUTPUT);
    WRITELN('List is now empty.');
    SHOW_MEM
END;

    (************************************************)
    (*                        *)
    (*            Initialize            *)
    (*                        *)
    (************************************************)

            { create first node }

PROCEDURE INITIALIZE(VAR LIST:LISTPOINT);

BEGIN
    { create list head }
    NEW(LIST);
    LIST^.LINK:=NIL;

    { set heap pointer }
    MARK(HEAP)
END;

(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
(*                                *)
(*            MAIN PROGRAM                *)
(*                                *)
(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

BEGIN{ main }
    INITIALIZE(LIST);

    { set of proper inputs }
    PROPCOMS:=['A','D','P','B','E'];

    WHILE COMMAND<>'E'
    DO BEGIN{ while }

        GOTOXY(40,0);
        WRITE('A(dd  B(lank  D(elete  P(rint  E(nd ');
        READ(COMMAND);
        IF (COMMAND IN PROPCOMS)
          THEN
          CASE COMMAND OF
            'A':BEGIN
              GET_NAME(TARGET,'add');
              INSERT(LIST,TARGET);
              PRINT_LIST(LIST,'CONSOLE:')
            END;

            'D':BEGIN
              GET_NAME(TARGET,'delete');
              DELETE(LIST,TARGET);
              PRINT_LIST(LIST,'CONSOLE:')
            END;

            { if you have no printer delete PRINT_LIST call
              with PRINTER: as a parameter }

            'P':BEGIN
              PRINT_LIST(LIST,'PRINTER:');
              PRINT_LIST(LIST,'CONSOLE:')
            END;

            'B':KILL_LIST(LIST)
        END{ case }

    END{ while }

END.{ main }

');
              PRINT_LIST(LIST,'CONSOLE:')
            END;

            'B':KILL_LIST(LIST)
        END{ case }

    END{ w